perm filename SP4NS.F4[JC,MUS] blob sn#007304 filedate 1972-07-16 generic text, type T, neo UTF8
00100		SUBROUTINE SPACE4(AMP,RAMP,DOP,CHNA,CHNB,CHNC,CHND,ARRAY)
00200		DIMENSION AMP(512),RAMP(512),DOP(512),
00300		1 CHNA(512),CHNB(512),CHNC(512),CHND(512)
00400	     	DIMENSION ARRAY(2,513),B(4)
00450		DATA (B(I),I=1,3)/'SP4 FUNCS FULL'/
00500		CALL RDNUM(DIS)
00600		DELTA=DIS/100.0
00700		CALL RDNUM(XNUM)
00800		L=XNUM
00900		GO TO (1,2),L
01000	2	ZT=180./512.
01100		ZK=-ZT
01200		PI=1.+(2/3.14159)
01300		XX=0
01400		CALL RDNUM(XCO1)
01500		CALL RDNUM(YCO1)
01600		CALL RDNUM(XCO2)
01700	      	CALL RDNUM(YCO2)
01800		XCOI=(XCO2-XCO1)/512.0
01900	        YCOI=(YCO2-YCO1)/512.0
02000		IL=1
02100	36	CONTINUE
02200		XX=ZK+ZT
02300		ZK=XX
02400		ARRAY(1,IL)=XCO1+(XCOI*SIND(XX)*PI)
02500		ARRAY(2,IL)=YCO1+(YCOI*SIND(XX)*PI)
02600		XCO1=ARRAY(1,IL)
02700		YCO1=ARRAY(2,IL)
02800		GO TO 520
02900	1	CALL RDNUM(XCO1)
03000		CALL RDNUM(YCO1)
03100		CALL RDNUM(FREQX)
03200		CALL RDNUM(PHASX)
03300	      	CALL RDNUM(FREQY)
03400		CALL RDNUM(PHASY)
03500		CALL RDNUM(FREQ2X)
03600		CALL RDNUM(PHAS2X)
03700		CALL RDNUM(FREQ2Y)
03800		CALL RDNUM(PHAS2Y)
03900		CALL RDNUM(DIA)
04000		CALL RDNUM(DIA2)
04100		XINC=(FREQX*360.)/512.
04200		XINC2=(FREQ2X*360.)/512.
04300		XK=-XINC+PHASX
04400		XK2=-XINC2+PHAS2X
04500		YINC=(FREQY*360.)/512.
04600		YINC2=(FREQ2Y*360.)/512.
04700		YK=-YINC+PHASY
04800		YK2=-YINC2+PHAS2Y
04900		IL=1
05000	37	CONTINUE
05100		XX=XK+XINC
05200		XX2=XK2+XINC2
05300		IF(XX.GE.360.)XX=XX-360.
05400		IF(XX2.GE.360.)XX2=XX2-360.
05500		XK=XX
05600		XK2=XX2
05700		YY=YK+YINC
05800		YY2=YK2+YINC2
05900		IF(YY.GE.360.)YY=YY-360.
06000		IF(YY2.GE.360.)YY2=YY2-360.
06100		YK=YY
06200		YK2=YY2
06300		ARRAY(1,IL)=XCO1+SIND(XX)*DIA+(SIND(XX2)*DIA2)
06400		ARRAY(2,IL)=YCO1+SIND(YY)*DIA+(SIND(YY2)*DIA2)
06500	520	CONTINUE
06600		IL=IL+1
06700		IF(IL.GT.512)GO TO 500
06800		GO TO (37,36),L
06900	500	CONTINUE
07000		M=512
07100		CALL RDNUM(SPD1)
07200		SPD1=60.0/((1.0/SPD1)*512.0)
07300	501	X=M-1
07400		AI=X/512.0
07500		BI=2.0
07600		S=60.0/SPD1
07700		R=SQRT(ARRAY(1,1)**2+ARRAY(2,1)**2)
07800		DO 100 J=1,512
07900		I=BI
08000		X=ARRAY(1,I)
08100		Y=ARRAY(2,I)
08200		BI=BI+AI
08300		R1=SQRT(X**2+Y**2)
08400		AMP(J)=(DIS/(R1*DELTA))**2
08500	C	RAMP(J)=ALOG(DIS)/ALOG(R1*DELTA)
08550		RAMP(J)=DIS/(R1*DELTA)
08600		IF(RAMP(J).GT.1.)RAMP(J)=1.
08700		CONTINUE
08800		VR=S*DELTA*(R1-R)
08900		XJ=J
09000		IF((R1.EQ.R).AND.(XJ.GT.1.0))GO TO 31
09100		DOP(J)=1180.0/(1180.0+VR)
09200		GO TO 21
09300	31	DOP(J)=DOP(J-1)
09400	21	R=R1
09500		CONTINUE
09600		AX=ABS(X)
09700		AY=ABS(Y)
09800		PI=3.1416
09900		ANGLE=AMOD(ATAN2(Y,X)+6.2832,6.2832)	
10000		PI2=PI/2.0
10100		IF((AX.LE.AY).AND.(Y.GT.0.0))GO TO 2000
10200		IF((AX.GT.AY).AND.(X.GT.0.0))GO TO 2001
10300		IF((AX.LE.AY).AND.(Y.LT.0.0))GO TO 2002
10400		CHN=ANGLE-(3.*PI)/4.	
10500		CHNB(J)=1.-CHN/PI2	
10600		CHNC(J)=CHN/PI2	
10700		CHNA(J)=0.0
10800		CHND(J)=0.0
10900		GO TO 100	
11000	2000	CHN=ANGLE-PI/4.
11100		CHNA(J)=1.-CHN/PI2	
11200		CHNB(J)=CHN/PI2	
11300		CHNC(J)=0.0
11400		CHND(J)=0.0
11500		GO TO 100	
11600	2001	CHN=ANGLE-(7.*PI)/4.	
11700		IF(ANGLE.LT.PI/4.)CHN=ANGLE+PI/4.
11800		CHND(J)=1.-CHN/PI2	
11900		CHNA(J)=CHN/PI2	
12000		CHNB(J)=0.0
12100		CHNC(J)=0.0
12200		GO TO 100	
12300	2002	CHN=ANGLE-(5.*PI)/4.	
12400		CHNC(J)=1.-CHN/PI2	
12500		CHND(J)=CHN/PI2	
12600		CHNA(J)=0.0
12700		CHNB(J)=0.0
12800	100	CONTINUE
12900		DO 402 JK=1,512
13000		CHNA(JK)=SQRT(CHNA(JK))
13100		CHNB(JK)=SQRT(CHNB(JK))
13200		CHNC(JK)=SQRT(CHNC(JK))
13300		CHND(JK)=SQRT(CHND(JK))
13400	402	CONTINUE
13500		CALL INTERP(AMP)
13600		CALL INTERP(RAMP)
13700		CALL INTERP(DOP)
13800	C	CALL INTERP(CHNA)
13900	C	CALL INTERP(CHNB)
14000	C	CALL INTERP(CHNC)
14100	C	CALL INTERP(CHND)
14150		CALL MESS(B)
14200		RETURN
14300		END
14400	CC******WAVE SMOOTHER********************************************
14500		SUBROUTINE INTERP(CFUNC)
14600		DIMENSION CFUNC(512)
14700		JT=0
14800		DO 601 KT=2,512
14900		IF(CFUNC(KT-1).NE.CFUNC(KT))GO TO 600
15000		IF(JT.EQ.0)JT=KT-1
15100		GO TO 601
15200	600	IF(JT.EQ.0)GO TO 601
15300		DIFF=CFUNC(KT)-CFUNC(JT)
15400		DIV=KT-JT
15500		ANS=DIFF/DIV
15600		DO 602 LM=JT+1,KT-1
15700	602	CFUNC(LM)=CFUNC(LM-1)+ANS
15800		JT=0
15900	601	CONTINUE
16000		RETURN
16100		END